home *** CD-ROM | disk | FTP | other *** search
/ Linux Cubed Series 3: Developer Tools / Linux Cubed Series 3 - Developer Tools.iso / devel / lang / fortran / toolpack.000 / toolpack / toolpack1.2 / tools / istme / ISTME.MAC.f
Encoding:
Text File  |  1989-03-04  |  8.4 KB  |  280 lines
  1. C---------------------------------------------------------
  2. C    TOOLPACK/1    Release: 3.1
  3. C---------------------------------------------------------
  4. C ----------------------------------------------------------------------
  5. C
  6. C       I S T M E   -   Mung Expressions
  7. C
  8. C       This program reads in a parse tree and works over expressions
  9. C       rearranging them so as to minimise the stack depth needed either
  10. C       to parse them or evaluate them (the latter is done easily except
  11. C       by the most stupid compilers, but you can never be too sure...).
  12. C       The only things assumed are that addition and multiplication are
  13. C       commutative.
  14. C
  15. C       Programmed by: Malcolm Cohen, Numerical Algorithms Group,
  16. C                      January 1986.
  17. C
  18.  
  19. C---------------------------------------------------------
  20. C    TOOLPACK/1    Release: 2.4
  21. C---------------------------------------------------------
  22. C---------------------------------------------------------
  23. C    TOOLPACK/1    Release: 2.4
  24. C---------------------------------------------------------
  25. C---------------------------------------------------------
  26. C    TOOLPACK/1    Release: 2.4
  27. C---------------------------------------------------------
  28.  
  29.  
  30.  
  31.  
  32.  
  33.  
  34.  
  35.  
  36. C                                   parameter length
  37.  
  38.  
  39.  
  40.  
  41.  
  42.  
  43.  
  44.  
  45.  
  46. C following are for ZYCSDT (Canonicalise Symbol Data Types)
  47.         PROGRAM ISTME
  48.  
  49.         INTEGER IODTRI,IODTRO,TROPTH(81),TRIPTH(81)
  50.  
  51.         INTEGER GETARG,OPEN,CREATE
  52.         EXTERNAL GETARG,OPEN,CREATE,ZYINPT,ZYTOUT,ZINIT,ZQUIT,ZMESS,
  53.      +           ERROR
  54.  
  55.         CALL ZINIT
  56.  
  57.         IF (GETARG(1,TRIPTH,81).EQ.-100) CALL MEARGS(1,TRIPTH)
  58.         IF (GETARG(2,TROPTH,81).EQ.-100) CALL MEARGS(2,TROPTH)
  59.  
  60.         IODTRI=OPEN(TRIPTH,0)
  61.         IF (IODTRI.EQ.-1) CALL ERROR('Can''t open input parse tree')
  62.         IODTRO=CREATE(TROPTH,1)
  63.         IF (IODTRO.EQ.-1) CALL ERROR('Can''t create output parse tree')
  64.  
  65.         CALL ZYINPT(IODTRI)
  66.  
  67.         CALL PROTRE
  68.  
  69.         CALL ZYTOUT(IODTRO)
  70.         CALL ZMESS('[ISTME Normal Termination]',1)
  71.         CALL ZQUIT(-2)
  72.  
  73.         END
  74. C ----------------------------------------------------------------------
  75. C
  76. C       M E A R G S   -   Get an argument for ISTME
  77. C
  78.  
  79.         SUBROUTINE MEARGS(N,ARG)
  80.         INTEGER N,ARG(81)
  81.  
  82.         INTEGER I,PROMPT(20,2)
  83.  
  84.         INTEGER ZGTCMD
  85.         EXTERNAL ZGTCMD,ZPRMPT,ERROR
  86.  
  87.         DATA (PROMPT(I,1),I=1,19)/73,110,112,117,116,32,112,
  88.      +97,114,115,101,32,116,114,101,101,58,32,129/,
  89.      +       (PROMPT(I,2),I=1,20)/79,117,116,112,117,116,32,
  90.      +112,97,114,115,101,32,116,114,101,101,58,32,
  91.      +129/
  92.  
  93.         CALL ZPRMPT(PROMPT(1,N))
  94.         IF (ZGTCMD(ARG,0).EQ.-1) CALL ERROR('ZGTCMD failed')
  95.  
  96.         END
  97. C ----------------------------------------------------------------------
  98. C
  99. C       P R O T R E   -   Process the parse tree
  100. C
  101. C       This routine looks at each statement in the parse tree.  If it
  102. C       finds an assignment statement, it then calls EXPRES with the
  103. C       right-hand side to do the work of munging it.
  104. C
  105.  
  106.         SUBROUTINE PROTRE
  107.  
  108.         INTEGER SPTR,PUPTR,PTR,PUNUM,STMTNO
  109.  
  110.         INTEGER ZYDOWN,ZYNEXT,ZYROOT,ZYNTYP
  111.         EXTERNAL ZYDOWN,ZYNEXT,ZYROOT,ZYNTYP
  112.  
  113.         PUPTR=ZYDOWN(ZYROOT())
  114.         PUNUM=1
  115.  
  116.  100    SPTR=ZYDOWN(PUPTR)
  117.         STMTNO=1
  118.  200    IF (ZYNTYP(SPTR).EQ.49) THEN
  119. C Found an assignment statement - work over its expression
  120.             PTR=ZYDOWN(SPTR)
  121.             IF (ZYNTYP(PTR).EQ.115) PTR=ZYNEXT(PTR)
  122.             CALL EXPRES(ZYNEXT(PTR),PUNUM,STMTNO)
  123.         END IF
  124.         SPTR=ZYNEXT(SPTR)
  125.         STMTNO=STMTNO+1
  126.         IF (SPTR.NE.0) GOTO 200
  127.         PUPTR=ZYNEXT(PUPTR)
  128.         PUNUM=PUNUM+1
  129.         IF (PUPTR.NE.0) GOTO 100
  130.  
  131.         END
  132. C ----------------------------------------------------------------------
  133. C
  134. C       E X P R E S   -   Expression munging
  135. C
  136. C       This routine works over an expression, putting the most deeply
  137. C       nested sub-expressions of "+" and "*" operators on the left-hand
  138. C       side (to make parsing easier).
  139. C
  140. C       We do not however swap sides when the tree structure comes from
  141. C       the left-to-right ordering of equal priority operators - in this
  142. C       case the existing ordering is preserved (in case some of the
  143. C       operands are of differing data types).
  144. C
  145. C       It also checks to make sure the depth of nesting of parentheses
  146. C       is not too large (parameter MAXDEP).
  147. C
  148.  
  149.         SUBROUTINE EXPRES(NODE,PUNUM,STMTNO)
  150.         INTEGER NODE,PUNUM,STMTNO
  151.  
  152.         INTEGER MAXDEP
  153.         PARAMETER (MAXDEP=16)
  154.  
  155.         INTEGER PTR,LHS,RHS,NEXTP,PDEPTH,NTYPE1,NTYPE2
  156.         LOGICAL WARNED
  157.  
  158.         INTEGER DEPTH
  159.  
  160.         INTEGER ZYDOWN,ZYNEXT,ZYUP,ZYNTYP,ZYCRND
  161.         EXTERNAL ZCHOUT,ZPTINT,PUTCH,ZYADNX,ZYDOWN,ZYNEXT,ZYUP,ZYNTYP,
  162.      +           ZYREPL,ZYCRND
  163.  
  164.         PTR=NODE
  165.         PDEPTH=0
  166.         WARNED=.FALSE.
  167.  100    NTYPE1=ZYNTYP(PTR)
  168.         IF (NTYPE1.EQ.95) THEN
  169.             LHS=ZYDOWN(PTR)
  170.             NTYPE1=ZYNTYP(LHS)
  171.             RHS=ZYNEXT(LHS)
  172.             NTYPE2=ZYNTYP(RHS)
  173.             IF (NTYPE1.NE.95 .AND. NTYPE1.NE.96 .AND.
  174.      +          NTYPE2.NE.95 .AND. NTYPE2.NE.96) THEN
  175.                 IF (NTYPE1.EQ.97) THEN
  176.                     IF (DEPTH(LHS).LT.DEPTH(RHS)) THEN
  177. C If the left-hand-side started with a monadic plus operator, remove it
  178.                         CALL ZYDELT(LHS)
  179.                         CALL ZYADNX(ZYDOWN(LHS),RHS)
  180.                     END IF
  181.                 ELSE IF (NTYPE1.EQ.46) THEN
  182.                     IF (DEPTH(LHS)+1.LT.DEPTH(RHS)) THEN
  183. C If the lhs started with a monadic minus, put parentheses around it
  184.                         CALL ZYDELT(LHS)
  185.                         LHS=ZYCRND(101,LHS)
  186.                         CALL ZYADNX(LHS,RHS)
  187.                     END IF
  188.                 ELSE IF (DEPTH(LHS).LT.DEPTH(RHS)) THEN
  189.                     CALL ZYADNX(LHS,RHS)
  190.                 END IF
  191.             END IF
  192.         ELSE IF (NTYPE1.EQ.98) THEN
  193.             LHS=ZYDOWN(PTR)
  194.             NTYPE1=ZYNTYP(LHS)
  195.             RHS=ZYNEXT(LHS)
  196.             NTYPE2=ZYNTYP(RHS)
  197.             IF (NTYPE1.NE.98 .AND. NTYPE1.NE.99 .AND.
  198.      +          NTYPE2.NE.98 .AND. NTYPE2.NE.99) THEN
  199.                 IF (NTYPE1.EQ.97) THEN
  200.                     IF (DEPTH(LHS).LT.DEPTH(RHS)) THEN
  201. C If the left-hand-side started with a monadic plus operator, remove it
  202.                         CALL ZYDELT(LHS)
  203.                         CALL ZYADNX(ZYDOWN(LHS),RHS)
  204.                     END IF
  205.                 ELSE IF (NTYPE1.EQ.46) THEN
  206.                     IF (DEPTH(LHS)+1.LT.DEPTH(RHS)) THEN
  207. C If the lhs started with a monadic minus, put parentheses around it
  208.                         CALL ZYDELT(LHS)
  209.                         LHS=ZYCRND(101,LHS)
  210.                         CALL ZYADNX(LHS,RHS)
  211.                     END IF
  212.                 ELSE IF (DEPTH(LHS).LT.DEPTH(RHS)) THEN
  213.                     CALL ZYADNX(LHS,RHS)
  214.                 END IF
  215.             END IF
  216.         ELSE IF (NTYPE1.EQ.101) THEN
  217.             PDEPTH=PDEPTH+1
  218.             IF (PDEPTH.GT.MAXDEP .AND. .NOT.WARNED) THEN
  219.                 WARNED=.TRUE.
  220.                 CALL ZCHOUT('Expression too deep at statement ',2)
  221.                 CALL ZPTINT(STMTNO,1,2)
  222.                 CALL ZCHOUT(' in program-unit ',2)
  223.                 CALL ZPTINT(PUNUM,1,2)
  224.                 CALL PUTCH(10,2)
  225.             END IF
  226.         END IF
  227.         NEXTP=ZYDOWN(PTR)
  228.         IF (NEXTP.LE.0) THEN
  229.             NEXTP=ZYNEXT(PTR)
  230.             IF (NEXTP.EQ.0) THEN
  231.                 IF (PTR.EQ.NODE) RETURN
  232.  200            PTR=ZYUP(PTR)
  233.                 IF (PTR.EQ.NODE) RETURN
  234.                 IF (ZYNTYP(PTR).EQ.101) PDEPTH=PDEPTH-1
  235.                 NEXTP=ZYNEXT(PTR)
  236.                 IF (NEXTP.EQ.0) GOTO 200
  237.             END IF
  238.         END IF
  239.         PTR=NEXTP
  240.         GOTO 100
  241.  
  242.  
  243.         END
  244. C ----------------------------------------------------------------------
  245. C
  246. C       D E P T H   -   Return depth of a subtree
  247. C
  248.  
  249.         INTEGER FUNCTION DEPTH(NODE)
  250.         INTEGER NODE
  251.  
  252.         INTEGER PTR,D,NEXTP
  253.  
  254.         INTEGER ZYDOWN,ZYNEXT,ZYUP
  255.         EXTERNAL ZYDOWN,ZYNEXT,ZYUP
  256.  
  257.         DEPTH=0
  258.         PTR=ZYDOWN(NODE)
  259.         IF (PTR.LE.0) RETURN
  260.         DEPTH=1
  261.         D=1
  262.  100    NEXTP=ZYDOWN(PTR)
  263.         IF (NEXTP.GT.0) THEN
  264.             D=D+1
  265.             DEPTH=MAX(DEPTH,D)
  266.         ELSE
  267.             NEXTP=ZYNEXT(PTR)
  268.             IF (NEXTP.EQ.0) THEN
  269.  200            PTR=ZYUP(PTR)
  270.                 IF (PTR.EQ.NODE) RETURN
  271.                 D=D-1
  272.                 NEXTP=ZYNEXT(PTR)
  273.                 IF (NEXTP.EQ.0) GOTO 200
  274.             END IF
  275.         END IF
  276.         PTR=NEXTP
  277.         GOTO 100
  278.  
  279.         END
  280.